home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / GAGACC.M < prev    next >
Encoding:
Text File  |  1990-12-16  |  10.0 KB  |  298 lines
  1. MODULE GagACC;
  2. (*$E MAC*)
  3.  
  4. (*
  5.  * Dies ist eine etwas komplexeres GEM- und Accessory-Demo.
  6.  * Es zeigt auch die Anwendung von "FormDo" sowie dem "Redraw"
  7.  * von Fenstern.
  8.  *
  9.  * Es ist eine Art Wecker, der zehn Minuten vor Erreichen einer
  10.  * bestimmbaren Tageszeit jede Minute eine Meldung anzeigt.
  11.  *
  12.  * Zuvor muß die GEM-Resource-Datei "GAG.RSC" mit dem NRSC.PRG
  13.  * geladen und gleich wieder gespeichert werden, um das benötigte
  14.  * Definitionsmodul "GAG.D" mit den Object-Konstanten zu erhalten.
  15.  * Dann können die Module übersetzt und gelinkt werden und "GAGACC.ACC"
  16.  * mit "GAG.RSC" als Accessory auf die Bootdisk kopiert werden.
  17.  *
  18.  * Das Programm wurde von Hannes Krohn während der CeBIT '90
  19.  * programmiert.
  20.  *)
  21.  
  22. IMPORT Gag;
  23.  
  24. FROM AESEvents          IMPORT  accClose,       accOpen,        Event,
  25.                                 EventSet,       MessageBuffer,  MultiEvent,
  26.                                 MessageEvent,   RectEnterMode,  windRedraw;
  27. FROM AESForms           IMPORT  FormAlert,      FormCenter,     FormDial,
  28.                                 FormDialMode,   FormDo;
  29. FROM AESGraphics        IMPORT  GrafMouse,      MouseForm;
  30. FROM AESMenus           IMPORT  RegisterAcc;
  31. FROM AESObjects         IMPORT  DrawObject;
  32. FROM AESResources       IMPORT  LoadResource,   ResourceAddr,   ResourcePart;
  33. FROM AESWindows         IMPORT  CalcWindow,     CloseWindow,    CreateWindow,
  34.                                 DeleteWindow,   NoWindow,       OpenWindow,
  35.                                 RListMode,      WCalcMode,      WElementSet,
  36.                                 UpdateWindow,   WindowRectList;
  37. FROM Clock              IMPORT  CurrentTime;
  38. FROM PrgCtrl            IMPORT  Accessory;
  39. FROM GEMEnv             IMPORT  InitApplication,ExitApplication,GemError;
  40. FROM GEMGlobals         IMPORT  GemChar,        MButtonSet,     PtrObjTree,
  41.                                 PtrTEdInfo,     Root,           MaxDepth,
  42.                                 SpecialKeySet;
  43. FROM GrafBase           IMPORT  BitsPerWord,    ClipRect,       Point,
  44.                                 Rect,           Rectangle,      WordBitSet;
  45. FROM MOSGlobals         IMPORT  Time;
  46. FROM StrConv            IMPORT  CardToStr,      NumToStr,       StrToCard;
  47. FROM Strings            IMPORT  Append,         Assign,         Concat,
  48.                                 Copy,           Split,          Empty;
  49. FROM SYSTEM             IMPORT  ADR;
  50.  
  51. PROCEDURE SelectObj (tree : PtrObjTree; obj : CARDINAL; sel : BOOLEAN);
  52. VAR
  53.         state : WordBitSet;
  54. BEGIN
  55.   state := tree^[obj].state;
  56.   IF sel THEN
  57.     INCL (state, b0)
  58.   ELSE
  59.     EXCL (state, b0)
  60.   END;
  61.   tree^[obj].state := state;
  62. END SelectObj;
  63.  
  64. PROCEDURE ObjSelected (tree : PtrObjTree; obj : CARDINAL) : BOOLEAN;
  65. BEGIN
  66.   RETURN b0 IN tree^[obj].state
  67. END ObjSelected;
  68.  
  69. VAR
  70.         success : BOOLEAN;
  71.         msgBuf : MessageBuffer;
  72.         mouseLoc : Point;
  73.         buttons : MButtonSet;
  74.         keyState : SpecialKeySet;
  75.         key : GemChar;
  76.         doneClicks : CARDINAL;
  77.         occuredEvents : EventSet;
  78.         fooC : CARDINAL;
  79.         tree : PtrObjTree;
  80.         open : BOOLEAN;
  81.         wHandle : CARDINAL;
  82.         windSpace : Rectangle;
  83.         time : LONGCARD;
  84.         r : Rectangle;
  85.         t : Time;
  86.         stage : CARDINAL;
  87.         dispText : ARRAY [1..30] OF CHAR;
  88.         title : ARRAY [1..10] OF CHAR;
  89.         active : BOOLEAN;
  90.         accId : CARDINAL;
  91.         msgTime : Time;
  92.         msgPre : CARDINAL;
  93.         
  94. PROCEDURE Config;
  95. VAR
  96.         tree : PtrObjTree;
  97.         resButton : CARDINAL;
  98.         diagRect : Rectangle;
  99.         hStr, mStr : ARRAY [0..2] OF CHAR;
  100.         allStr : ARRAY [0..4] OF CHAR;
  101.         tedPtr : PtrTEdInfo;
  102.         fooC : CARDINAL;
  103.         
  104. BEGIN
  105.   tree := ResourceAddr (treeRsrc, Foset);
  106.   
  107.   (* Buttons selektieren, Werte einsetzen *)
  108.   Assign (NumToStr (msgPre, 10, 0, '0'), hStr, success);
  109.   tedPtr := tree^[Ftpre].spec.more;
  110.   Assign (hStr, tedPtr^.textPtr^, success);
  111.   
  112.   Assign (NumToStr (msgTime.hour, 10, 0, '0'), hStr, success);
  113.   Assign (NumToStr (msgTime.minute, 10, 0, '0'), mStr, success);
  114.   tedPtr := tree^[Fttime].spec.more;
  115.   Concat (hStr, mStr, tedPtr^.textPtr^, success);
  116.   SelectObj (tree, Btan, active);
  117.   SelectObj (tree, Btaus, ~active);
  118.   SelectObj (tree, Btfertig, FALSE);
  119.   
  120.   (* Dialog animieren *)
  121.   diagRect := FormCenter (tree);
  122.   FormDial (reserveForm, diagRect, diagRect);
  123.   GrafMouse (mouseOff, NIL);
  124.   DrawObject (tree, Root, MaxDepth, diagRect);
  125.   GrafMouse (mouseOn, NIL);
  126.   FormDo (tree, Root, resButton);
  127.   FormDial (freeForm, diagRect, diagRect);
  128.   
  129.   (* Werte auslesen *)
  130.   active := ObjSelected (tree, Btan);
  131.   Assign (tedPtr^.textPtr^, allStr, success);
  132.   WHILE LENGTH (allStr) < 4 DO
  133.     Append ('0', allStr, success)
  134.   END;
  135.   Split (allStr, 2, hStr, mStr, success);
  136.   fooC := 0;
  137.   msgTime.hour := StrToCard (hStr, fooC, success);
  138.   fooC := 0;
  139.   msgTime.minute := StrToCard (mStr, fooC, success);
  140.   tedPtr := tree^[Ftpre].spec.more;
  141.   fooC := 0;
  142.   msgPre := StrToCard (tedPtr^.textPtr^, fooC, success);
  143.   IF open AND ~active THEN
  144.     CloseWindow (wHandle);
  145.     DeleteWindow (wHandle);
  146.     open := FALSE;
  147.     stage := 0
  148.   END
  149. END Config;
  150.  
  151. PROCEDURE SetText (text : ARRAY OF CHAR);
  152. VAR
  153.         boxSpace, textSpace : Rectangle;
  154.         success : BOOLEAN;
  155. BEGIN
  156.   Assign (text, dispText, success);
  157.   boxSpace := tree^[Root].space;
  158.   textSpace := tree^[Text].space;
  159.   textSpace.w := 8 * LENGTH (text);
  160.   boxSpace.w := 2 * textSpace.x + textSpace.w;
  161.   boxSpace.h := 2 * textSpace.y + textSpace.h;
  162.   tree^[Root].space := boxSpace;
  163.   tree^[Text].space := textSpace;
  164.   tree^[Text].spec.more := ADR (dispText);
  165.   boxSpace := FormCenter (tree);
  166.   windSpace := CalcWindow (calcBorder, WElementSet{}, boxSpace);
  167.   CreateWindow (WElementSet{}, windSpace, wHandle);
  168.   IF wHandle # NoWindow THEN
  169.     OpenWindow (wHandle, windSpace);
  170.   END
  171. END SetText;
  172.  
  173. BEGIN
  174.   InitApplication (success);
  175.   IF success THEN
  176.     IF NOT Accessory() THEN
  177.       FormAlert (1, "[0][GAGACC läuft nur |als Accessory!][OK]", fooC);
  178.       ExitApplication;
  179.       RETURN
  180.     END;
  181.     LoadResource ("GAG.RSC");
  182.     IF GemError () THEN
  183.       FormAlert (1, "[0][Accessory GAGACC: |GAG.RSC fehlt!][OK]", fooC);
  184.       success:= FALSE
  185.     ELSE
  186.       tree := ResourceAddr (treeRsrc, Box);
  187.       Assign ("  GagAcc", title, success);
  188.       RegisterAcc (ADR (title), accId, success)
  189.     END
  190.   END;
  191.   IF ~success THEN
  192.     LOOP
  193.       MessageEvent (msgBuf)
  194.     END
  195.   ELSE
  196.     msgTime.hour := 17;
  197.     msgTime.minute := 50;
  198.     msgPre := 10;
  199.     time := 8000;
  200.     open := FALSE;
  201.     stage := 0;
  202.     active := TRUE;
  203.     LOOP
  204.       MultiEvent (EventSet {message, timer},
  205.                             0, MButtonSet{}, MButtonSet{},
  206.                             lookForEntry, Rect (0,0,0,0),
  207.                             lookForEntry, Rect (0,0,0,0),
  208.                             msgBuf,
  209.                             time,
  210.                             mouseLoc, buttons,
  211.                             keyState, key,
  212.                             doneClicks,
  213.                             occuredEvents);
  214.       UpdateWindow (TRUE);
  215.       IF (timer IN occuredEvents) AND active THEN
  216.         (* Action ! *)
  217.         t := CurrentTime ();
  218.         
  219.         (* Um 17.50 h Warnung! *)
  220.         IF (((t.hour = msgTime.hour) AND (t.minute >= msgTime.minute))
  221.             OR (t.hour > msgTime.hour))
  222.         AND (stage = 0) THEN
  223.           IF ~open THEN
  224.             (* Warnung ausgeben *)
  225.             dispText := "Noch ";
  226.             Append (CardToStr (msgPre, 0), dispText, success);
  227.             IF msgPre = 1 THEN
  228.               Append (" Minute!", dispText, success);
  229.             ELSE
  230.               Append (" Minuten!", dispText, success);
  231.             END;
  232.             SetText (dispText);
  233.           ELSE
  234.             IF wHandle # NoWindow THEN
  235.               CloseWindow (wHandle);
  236.               DeleteWindow (wHandle);
  237.               INC (stage);
  238.               IF msgTime.minute >= (60 - msgPre) THEN
  239.                 INC (msgTime.hour);
  240.                 DEC (msgTime.minute, (60 - msgPre))
  241.               ELSE
  242.                 INC (msgTime.minute, msgPre)
  243.               END
  244.             END
  245.           END;
  246.           open := ~open
  247.         END;
  248.             
  249.         (* Um 18.00h blinken *)
  250.         IF (((t.hour = msgTime.hour) AND (t.minute >= msgTime.minute)) OR
  251.             (t.hour > msgTime.hour)) AND (stage = 1) THEN
  252.           IF open THEN
  253.             IF wHandle # NoWindow THEN
  254.               CloseWindow (wHandle);
  255.               DeleteWindow (wHandle);
  256.             END
  257.           ELSE
  258.             (* Fenster öffnen *)
  259.             SetText ("Jetzt ist aber Schluß!");
  260.           END;
  261.           open := ~open
  262.         END
  263.       ELSIF message IN occuredEvents THEN
  264.         WITH msgBuf DO
  265.           CASE msgType OF
  266.             accClose : IF (aClsMId = accId) AND open THEN
  267.                          (* Fenster wurde bereits geschlossen
  268.                            CloseWindow (wHandle);
  269.                          *)
  270.                          DeleteWindow (wHandle);
  271.                          open := FALSE;
  272.                          stage := 1
  273.                        END|
  274.             accOpen : IF aOpnMId = accId THEN
  275.                         Config;
  276.                       END|
  277.             windRedraw : IF rdrwHdl = wHandle THEN
  278.                            GrafMouse (mouseOff, NIL);
  279.                            r := WindowRectList (wHandle, firstElem);
  280.                            WHILE (r.w # 0) OR (r.h # 0) DO
  281.                              r := ClipRect (r, rdrwFrame);
  282.                              IF (r.w # 0) AND (r.h # 0) THEN
  283.                                DrawObject (tree, Root, MaxDepth, r)
  284.                              END;
  285.                              r := WindowRectList (wHandle, nextElem);
  286.                            END;
  287.                            GrafMouse (mouseOn, NIL);
  288.                          END
  289.           ELSE
  290.             (* ignorieren *)
  291.           END
  292.         END
  293.       END;
  294.       UpdateWindow (FALSE)
  295.     END (* LOOP *)
  296.   END;
  297. END GagACC.
  298.